perm filename SCORB.F4[TMP,LCS] blob
sn#128755 filedate 1974-11-07 generic text, type T, neo UTF8
00001 C SCORB.F4 2ND HALF OF SCORE.
00003 SUBROUTINE RUNIT
00005 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00009 COMMON/A/ ROFF(27),V(2000),NP(27),PCH(27,32),
00017 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00025 1 ,P1(27),JFM(4),COPY(30),IFM(80)
00033 1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
00041 DIMENSION IV(2000),IT(30),IOUT(70),JPT(837),NCNT(27,32)
00049 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
00057 C 40 LIT CHARS + 30 PARAMS PER INST.
00065 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
00073 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
00081 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
00089 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
00100 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,ITYP,INONLY,MX,
00121 1 Y,Z,ISLAC,MZ,LN,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
00142 1 ZZ,CHN,YY
00163 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
00187 1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
00205 1 KODE,RD,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,NPAR,
00240 1 VIJ2,QQQ
00275 C /C/=26
00310 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
00314 1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
00318 1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
00322 1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
00326 1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
00330 1 ,(IFM4,IFM(4))
00334 DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
00338 1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
00342 1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
00346 1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
00350 1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
00354 1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
00358 1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
00362 1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
00366 1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
00370 1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
00374 1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
00378 1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
00382 2337 T=0
00386 DO 1107 K=1,30
00390 1107 PL(K)=1.
00400 C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
00500 IF(ITYP)GO TO 23371
00600 END FILE 21
00700 DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
00800 TYPE ENFI
00900 C**** NOT THIS ***** PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
00910 C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT SCORX
01000 23371 IF(SOS)WRITE(JOUT,902)
01100 C WRITES A BLANK LINE
01200 NWZZ=0
01300 IAMP=0
01400 IT3=0
01500 K=1
01600 IX=0
01700 BG(NINS+1)=19999.
01800 4011 IF(CNT(K))GO TO 5011
01900 6011 IF(K.EQ.KZY)GO TO 4337
02000 K=K+1
02100 GO TO 4011
02200 5011 L=V(I-1)/(-9900.)
02300 IF(L.EQ.1)I=I-1
02400 V(I)=CNT(K)
02500 V(I+1)=P(K)
02600 V(I+3)=-44.
02700 I=I+5
02800 IF(P(K).EQ.980000.)I=I-4
02900 KL=I
03000 REWIND 1
03100 ICT=IPT(K,1)
03200 CALL IFILE(1,ICT)
03300 9011 L=I+6
03400 READ(1,7011)(V(M),M=I,L)
03500 C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
03600 IF(V(L).EQ.999.)GO TO 8011
03700 I=L+1
03800 GO TO 9011
03900 8011 IF(P(K).NE.980000.)GO TO 6337
04000 DO 7337 K=L,I,-1
04100 7337 IF(V(K).NE.999.)GO TO 8337
04200 8337 I=K-1
04300 V(I)=0
04400 V(I+1)=V(K)
04500 V(I+2)=V(K)
04600 C K WAS I-1 ABOVE.
04700 I=I+3
04800 V(KL+1)=I-KL-1
04900 C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
05000 GO TO 4337
05100 6337 DO 5337 M=I,L
05200 KN=M
05300 5337 IF(V(M).EQ.999.)GO TO 3337
05400 3337 I=KN
05500 KN=I-KL
05600 V(KL-1)=KN
05700 V(KL-3)=KN+3
05800 GO TO 6011
05900 7011 FORMAT(7F)
06000 4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
06100 V(I)=-19899.
06200 PP1=0
06300 T6=10000.
06400 DO 2118 K=1,NINS
06500 ROFF(K)=0
06600 C********* FEB 17,71
06700 M=NP(K)
06800 IT(K)=0
06900 IPT(K,31)=0
07000 NCNT(K,31)=1
07100 DO 2118 L=1,M
07200 NCNT(K,L)=1
07300 2118 IPT(K,L)=0
07400 DO 5013 K=1,IXIN
07500 5013 X=RAND(0.0,0.0)
07600 REWIND 1
07700 IF(MX)CALL OFILE(1,ISLAC)
07800 NW=1
07900 NWX=0
08000 TDUR=0
08100 A=0
08200 T2=1.
08300 T4=1.
08400 T5=0
08500 J=1
08600 MK=0
08700 C IS THE ABOVE NEEDED?
08800 IF(MX.NE.3)GO TO 40021
08900 K=4
09000 10023 N=AMOD(V(K),100.0)/-11.
09100 C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
09200 IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
09300 1 .V(K-2).LT.10000.)GO TO 10021
09400 J=V(K+1)
09500 IF(J.EQ.1)GO TO 10024
09600 IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
09700 N=V(K-2)
09800 L=N/10000
09900 M=N-L*10000
10000 TYPE 10022,INST(L),M,J
10100 10024 K=K+ABS(V(K-1))
10200 10021 K=K+1
10300 IF(K.LT.I)GO TO 10023
10400 40021 IF(MZ.NE.-4)GO TO 1002
10500 N=1
10600 40022 K=N+1
10700 IF(N.GT.I)CALL EXIT
10800 X=V(N)
10900 IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
11000 IF(X.GE.0)GO TO 40023
11100 PRINT 4002,X
11200 N=N+1
11300 GO TO 40022
11400 40024 J=N+1
11500 GO TO 40025
11600 C FOR 'SECTIONS'
11700 40023 J=ABS(V(K))+K-1
11800 40025 PRINT 4002,(V(K),K=N,J)
11900 N=J+1
12000 GO TO 40022
12100 10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
12200 4002 FORMAT(10F12.3)
12300 1002 IF(IDALL)GO TO 600
12400 X=DUR(IDALL)
12500 DO 2002 K=1,NINS
12600 2002 IF(DUR(K))DUR(K)=X
00100 C ***** SORTER *************************
00200 C ******* OUTPUT LOOP FROM HERE ON ********
00300 600 IL=0
00400 C********** BELOW IS FOR 'SECTIONS'
00500 KODE=0
00600 NWX=NWX+1
00700 MK=MK+1
00800 Y=BNW(NW)
00900 723 IL=IL+1
01000 3723 Z=V(IL)
01100 IF(Z.EQ.-19899.)GO TO 732
01200 IF(Z.NE.-9900.-Y)GO TO 723
01300 C********** BELOW IS FOR 'SECTIONS'
01400 IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500 2723 IL=IL+1
01600 729 K=IL+2
01700 MOT=V(IL+1)
01800 RD=V(K)
01900 IF(RD.EQ.-67.)GO TO 3726
02000 RB=V(IL)
02100 C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200 IF(RB.NE.-99.)GO TO 4150
02300 KODE=IV(K-1)
02400 2160 IF(KODE.EQ.0)GO TO 723
02500 IF(MZ)WRITE(JOUT,9150),KODE
02600 KL=Y/10000.
02700 RB=Y+KL*10000.
02800 DO 5150 KL=1,I
02900 IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000 IV(K-1)=0
03100 C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200 RD=V(KL+2)+9900.
03300 DO 6150 L=KL+2,I
03400 M=V(L)/(-9900.)
03500 IF(M.NE.1)GO TO 6150
03600 RA=RB+RD-V(L)-9900.
03700 V(L)=-9900.-RA
03800 C UPDATES BG TIMES INSIDE SECTION.
03900 CALL BGSORT(RA)
04000 C7150 IF(RA.EQ.BNW(KA))GO TO 6150
04100 C UPDATES LIST OF CHANGE TIMES.
04200 6150 IF(V(L).EQ.-299.)GO TO 160
04300 5150 CONTINUE
04400 160 IL=1
04500 GO TO 3723
04600 C*********** ABOVE IS FOR 'SECTION' REPEATS
04700 4150 LK=RB/10000.+.2
04800 IF(LK.GE.98)GO TO 7700
04900 LP=RB-LK*10000
05000 C LK=INST # LP=PARAM #
05100 LN=IPT(LK,LP)
05200 IPT(LK,LP)=IL+2
05300 IF(RD.EQ.-66.)GO TO 726
05400 IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500 IF(RD.EQ.-23)GO TO 6700
05600
05700 2727 ML=IPT(LK,LP)
05800 IF(MOT.GT.0)GO TO 3727
05900 C USE NEG WDCNT FOR 'ALL'
06000 DO 4727 KL=LK+1,NINS
06100 IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200 IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300 NCNT(KL,LP)=10000
06400 4727 IF(DUR(KL))DUR(KL)=1000.
06500 C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600 C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700 GO TO 727
06800 C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
06900 3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
07000 DO 1727 L=1,NINS
07100 DO 1727 KL=1,NP(L)
07200 IF(LN.NE.IPT(L,KL))GO TO 1727
07300 NCNT(L,KL)=10000
07400 C ******* JAN 29,70
07500 IPT(L,KL)=ML
07600 C RESETS POINTERS FOR DUPL AND REP INSTS.
07700 C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
07800 1727 CONTINUE
07900 727 NCNT(LK,LP)=10000
08000 C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08100 2150 IF(MOT)MOT=-MOT
08200 IL=IL+MOT+1
08300 3150 IF(V(IL))GO TO 3723
08400 GO TO 729
08500 726 RB=V(IL+3)
08600 K=RB/10000.
08700 L=RB-K*10000
08800 IPT(LK,LP)=-(K+(L-1)*KZY)
08900 GO TO 2727
09000 3726 LK=V(IL)
09100 M=V(K+1)
09200 KL=NP(M)
09300 DO 4726 L=1,KL
09400 IPT(LK,L)=IPT(M,L)
09500 IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09600 C****** JUN 29 71 (LK,L) WAS (L,K)....???????
09700 4726 CONTINUE
09800 IPT(LK,31)=IPT(M,31)
09900 K=0
10000 GO TO 2150
10100 C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
10200 6700 KL=IL+V(IL+1)+1.3
10300 RC=V(K-2)
10400 1770 IF(V(KL))GO TO 700
10500 2700 KL=KL+V(KL+1)+1.3
10600 GO TO 1770
10700 700 KL=KL+1
10800 IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
10900 KL=KL+3
11000 KN=IL+3
11100 LN=V(KN)+.3
11200 DO 3700 L=1,LN,2
11300 RA=V(L+KN)
11400 KA=V(L+KN+1)+.3
11500 RB=0
11600 DO 4700 LP=1,KA
11700 4700 RB=RB+V(KL+LP)
11800 DO 5700 LP=1,KA
11900 5700 V(KL+LP)=V(KL+LP)/RB*RA
12000 V(KL+KA)=V(KL+KA)+.00030
12100 3700 KL=KL+KA
12200 GO TO 2150
12300
12400 C BELOW FOR 'TEMPO' SETUP
12500 7700 T2=V(IL+4)
12600 T1=V(IL+3)
12700 TBG=Y
12800 TDUR=V(IL+2)
12900 CALL SQYY(AC,T1,T2,TDUR)
13000 8700 IF(TDUR.EQ.0)TDUR=10000.
13100 T5=1.
13200 T6=TBG+TDUR
13300 IT3=1.
13400 IF(LK.EQ.98)IT3=IL+2
13500 T4=1.
13600 GO TO 2150
13700 C*************** ANY WDCNTS DOWN FROM HERE. *********
13800 C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
13900 1726 IF(V(IL-1).GT.-19000.)GO TO 2727
14000 RA=BT
14100 K=IL-1
14200 2726 V(K)=-9900.-RA
14300 ISUB=-1
14400 L=K+5
14500 RB=V(L)+V(L-1)
14600 V(L-1)=RA
14700 K=K+V(K+2)+2
14800 IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
14900 1 V(K).NE.-9900.-RB)GO TO 2727
15000 RA=RA+V(L)
15100 CALL BGSORT(RA)
15200 GO TO 2726
15300 C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
15400 C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
15500 732 DO 2606 K=NW,NWZ
15600 2606 BNW(K)=BNW(K+1)
15700 NWZ=NWZ-1
15800 IF(NWZ.EQ.0)GO TO 2111
15900 IF(NWZZ.EQ.1)GO TO 5111
16000 NWZZ=1
16100 IF(NWZ.EQ.1)GO TO 1111
16200 DO 3111 K=1,NWZ
16300 IF(BNW(K).LT.1000.)GO TO 3111
16400 X=BNW(NWZZ)
16500 BNW(NWZZ)=BNW(K)
16600 BNW(K)=X
16700 NWZZ=NWZZ+1
16800 3111 CONTINUE
16900 5111 IF(NWZZ.EQ.NWZ)GO TO 1111
17000 L=NWZZ+1
17100 X=BNW(NWZZ)
17200 DO 4111 K=L,NWZ
17300 IF(BNW(K).GT.X)GO TO 4111
17400 RA=BNW(K)
17500 BNW(K)=X
17600 X=RA
17700 4111 CONTINUE
17800 BNW(NWZZ)=X
17900 GO TO 1111
18000 111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18100 1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2,4X,
18200 1'RANDOM NUMBER =',I6/)
18310 1023 FORMAT(/' < ',A5,'.DAT '/1XA5)
18400 C********** BELOW IS FOR 'SECTIONS'
18500 9150 FORMAT(/3X'******* SECTION ',A1)
18600 2111 NWZ=-1
18700 C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
18800 1111 IF(MZ.EQ.0)GO TO 1601
18900 IF(NWX.NE.1)GO TO 1486
19010 WRITE(JOUT,111)ISLAC,IFLNM,I,TF,IXIN
19100 C*********** JUNE 1,71
19200 C********** BELOW IS FOR 'SECTIONS'
19300 1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19400 K=NWX-1
19500 C*********** JUNE 1,71
19600 IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y
19700 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
19800 C*********** JUNE 1,71 X 3 K'S
19900
20000 DO 602 K=1,NINS
20100 48 LK=INST(K)
20200 C*********** JUNE 1,71
20300 IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
20400 NCNT(K,31)=1
20500 IJ=IPT(K,31)
20600 X=0
20700 IF(IJ.NE.0)X=V(IJ+2)
20800 WRITE(JOUT,5396),LK,X
20900 X=DUR(K)
21000 IF(X.GT.10000.)GO TO 83
21100 WRITE(JOUT,8396),X
21200 GO TO 602
21300 5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
21400 7396 FORMAT('+',F5.0,' NOTES')
21500 8396 FORMAT('+',F6.2,'"')
21600 83 X=X-10000.
21700 WRITE(JOUT,7396),X
21800 602 CONTINUE
21900 715 IF(IT3.NE.1.)GO TO 1602
22000 RA=T1*TP
22100 RB=T2*TP
22200 WRITE(JOUT,6154),RA,RB,TDUR
22300 IT3=0
22400 1602 IF(NWX.EQ.1)GO TO 315
22500 IF(IT(J).EQ.-3)GO TO 1108
22600 C*********** JUNE 1,71
22700 6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
22800 7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
22900 5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23000 902 FORMAT(1XA5/)
23100 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23200 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
23300 C*********** JUNE 1,71
23400 IT(J)=IT(J)/10
23500 GO TO 1108
23600 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
23700 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
23800 1601 IF(NWX.GT.1) GO TO 1108
23910 IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
24000 IF(TF.GT.10.)TF=TF/60.
24100 TF=1000./TF
24200 DO 6015 K=1,30
24300 6015 COPY(K)=-9900.
24400 C INITS PARAM REPRESSION FEATURE.
24500 IF(KB.EQ.0)GO TO 9926
24600 ML=NINS+1
24700 NL=NINS+KB
24800 DO 9826 K=ML,NL
24900 9826 BG(K)=OTH(K-NINS,1)
25000 C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
25100 9926 DO 5015 K=1,NINS
25200 IQ(K)=BG(K)*10000.
25300 BG(K)=0
25400 INP(K)=0
25500 P1(K)=0
25600 IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
25700 C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
25800 5015 CNT(K)=0
25910 IF(MX)WRITE(1,1023)ISLAC,PLAY
26000 BW=0
26100 GO TO 500
00100 752 FORMAT(1X15A5)
00200 1108 M=0
00300 JC=0
00400 IF(NWZ)GO TO 1740
00500 C NWZZ IS SET AT 3111 IN SORTR.
00600 DO 740 K=1,NWZZ
00700 X=BNW(K)
00800 IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900 IT(J)=IT(J)*10
01000 NW=K
01100 GO TO 600
01200 2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300 X=BT+PR
01400 NW=K
01500 BX=CNT(J)+1.
01600 IT(J)=-3
01700 GO TO 600
01800 740 CONTINUE
01900 IT(J)=0
02000 1740 IF(J.LE.NINS)GO TO 31
02100 7021 K=J-NINS
02200 IF(JC.GT.0)K=JC
02300 5740 IF(PP1.LT.OP1)GO TO 1752
02400 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
02500 IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
02600 C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
02700 C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
02800 DO 17521 L=3,30
02900 17521 COPY(L)=-9900.
03000 C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100 1752 BG(K+NINS)=19999.
03200 OTH(K,1)=19999.
03300 IF(JC.GT.0)GO TO 21
03400 31 KL=1
03500 IF(KB.EQ.0)GO TO 2031
03600 DO 1031 L=1,KB
03700 K=L
03800 X=OTH(K,1)-1000000.
03900 M=X/100000.
04000 IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031
04100 C M=INST
04200 IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
04300 1031 CONTINUE
04400 IF(J.GT.NINS)GO TO 500
04500 2031 CNT(J)=CNT(J)+1
04600 ICT=CNT(J)
04700 C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800 NPA=NP(J)
04900 PP1=P1(J)
05000 IF(BT.GE.DUR(J))GO TO 5174
05100 IF(IQ(J).EQ.0)GO TO 200
05200 P2=-IQ(J)/10000.
05300 IQ(J)=0
05400 CNT(J)=-1
05500 ICT=-1
05600 GO TO 4203
05700
05800 C MK IS FLAG FOR RESTS
05900 200 MK=0
06000 IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
06100 KN=IPT(J,1)-1
06200 IF(KN.GT.0)GO TO 12033
06300 12032 KN=JPT(-KN)
06400 IF(KN)GO TO 12032
06500 KN=KN-1
06600 C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
06700 C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800 12033 IJ=V(KN)
06900 IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000 C 'IABS' IS FOR -4 USED WITH 'ALL'
07100 Z=(BT+9900.+V(KN-2))/V(KN+2)
07200 C******* FEB 19,71
07300 IF(Z.GT.1.)Z=1.
07400 Y=V(KN+3)
07500 X=(V(KN+4)-Y)*Z+Y
07600 C******* FEB 19,71
07700 GO TO 204
07800 1203 X=V(KN+3)
07900 204 Y=RAND(0.0,1.0)
08000 IF(Y-X)MK=-1
08100
08200 203 DF=1.
08300 C DF=DUTY FACTOR
08400 DO 2155 L=2,NPA
08500 ISUB=0
08600 C WHY DOES ISUB APPEAR AT 14700/5?
08700 IDF=0
08800 C IDF IS DUTY FACTOR FLAG
08900 IJ=IPT(J,L)
09000 12031 IF(IJ)IJ=JPT(-IJ)
09100 IF(IJ)GO TO 12031
09200 C FOLLOWS UP ON POINTERS TO POINTERS!
09300 PM=1.
09400 IF(IJ.GT.1)GO TO 2157
09500 P(L)=0
09600 GO TO 21551
09700 C 7/73
09800 2157 LN=IJ+2
09900 NM=ABS(V(IJ-1))+LN-4
10000 NL=V(IJ)
10100 IF(NL.GT.-200)GO TO 372
10200 ISUB=-1
10300 NL=NL+200
10400 C FOR SUBROUTINE FLAG
10500 372 IF(NL.GT.-100)GO TO 272
10600 IDF=-1
10700 NL=NL+100
10800 C DEC.6,72 FINDS DUTY FACTOR PARAM
10900 272 VIJ2=V(IJ+1)
11000 KN=NL/(-11)
11100 IF(KN.EQ.0)GO TO 1100
11200 GO TO (61,62,62,62,65,65,67,68),KN
11300 1100 IF(VIJ2.EQ.1.)GO TO 1200
11400 ML=3
11500 1900 KA=1
11600 VX1=0
11700 DO 1156 K=LN,NM,ML
11800 VX(KA+1)=V(K)+VX(KA)
11900 1156 KA=KA+1
12000 X=RAND(0.0,1.)
12100 DO 1157 K=2,11
12200 IF(X.GT.VX(K))GO TO 1157
12300 KL=K-1
12400 IF(KN.EQ.7)GO TO 6157
12500 GO TO 1400
12600 1157 CONTINUE
12700 1400 LN=IJ+3*KL
12800 1462 RA=V(LN)
12900 IF(RA.EQ.10000.)GO TO 5174
13000 C FOR "FINE" IN RLIST
13100 RB=V(LN+1)
13200 PAR=RAND(RA,RB)
13300 1300 IF(NL.NE.-1)PM=2.
13400 C IF 2 THEN PRINTS A5
13500 GO TO 1155
13600 1200 PAR=V(IJ+2)
13700 GO TO 1300
13800 C NEXT IS FOR SUBROUTINE AND QUAD CALLS
13900 61 IF(NL.LT.-12)GO TO 6100
14000 601 X=P2
14100 C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14200 CALL SUBR
14400 CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
14500 C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
14600 IF(L.EQ.2)GO TO 4203
14700 IF(X.EQ.P2)GO TO 21552
14800 PP2=P2
14900 PR=P2
15000 GO TO 21552
15100 C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15200 C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15300 C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15400 C BE SET TO 'REAL TIME'.)
15500
15600 C NEXT IS FOR QUAD ROUTINES
15700 6100 CALL QUAD(NL)
15800 GO TO 21552
15900
16000 C FOLLOWING IS FOR STRINGS OF VALUES.
16100 62 KL=NCNT(J,L)+1
16200 IF(KL.GT.VIJ2)KL=1
16300 IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
16400 C THIS PART FOR STRINGS OF RAND SELECTION
16500 LN=KL+IJ+1
16600 KL=KL+1
16700 IF(KL.GT.VIJ2)KL=1
16800 NL=NL+45
16900 C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
17000 162 NCNT(J,L)=KL
17100 IF(NL.GT.-22)GO TO 1462
17200 C JUMP RAND SELECTION
17300 PAR=V(IJ+KL+1)
17400 C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
17500 C************************
17600 IF(KN.NE.3)GO TO 1155
17700 C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
17800 IF(PAR.EQ.10000.)GO TO 5174
17900 PM=2.
18000 IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
18100 IF(PAR.EQ.85.)MK=-1
18200 GO TO 5155
18300 65 W=-9900.-V(IJ-3)
18400 C W=BG TIME OF MOVE.
18500 X=ABS(V(IJ-1))
18600 IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
18700 Z=(BT-W)/VIJ2
18800 C Z= % OF WAY THROUGH.
18900 IF(Z.GT.1.)Z=1.
19000 Y=V(LN)
19100 W=V(IJ+3)
19200 IF(X.EQ.7.)W=V(IJ+4)
19300 IF(NL.LT.-58)GO TO 16002
19400 PAR=(W-Y)*Z+Y
19500 IF(X.EQ.7.)GO TO 1600
19600 GO TO 1155
19700 C************** JUNE 1,71
19800 C FOR "MOVX"
19900 C******** FEB/73
20000 C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
20100 16002 PAR=RMOVX(W,Y,Z)
20200 C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
20300 C THIS NEEDS WORK!
20400 IF(X.NE.7.)GO TO 1155
20500 W=V(IJ+5)
20600 Y=V(IJ+3)
20700 X=RMOVX(W,Y,Z)
20800 GO TO 16003
20900 C NEXT IS FOR MOVING RAND RANGES.
21000 C1600 PAR=(V(IJ+4)-Y)*Z+Y
21100 1600 W=V(IJ+3)
21200 C*********** BACK TO 65 IS NEW. FEB. 15,71
21300 X=(V(IJ+5)-W)*Z+W
21400 C************ JUNE 1,71
21500 16003 PAR=RAND(PAR,X)
21600 GO TO 1155
21700 67 LN=IJ+3
21800 NM=LN+VIJ2-1
21900 ML=1
22000 GO TO 1900
22100 4155 K=(PAR-9999.0)*100.+.1
22200 P(L)=P(K)
22210 IF(L.EQ.2.AND.K.EQ.2)P2=PX2
22220 C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
22300 PM=PL(K)
22400 GO TO 21551
22500 C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
22510 C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
22520 C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
22530 C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
22540 C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
22600 6157 LN=V(LN-1)
22700 DO 1068 K=1,KL
22800 1068 IF(K.LT.KL)LN=LN+V(LN)+1
22900 2068 PM=LN+1
23000 PAR=LN+V(LN)
23100 GO TO 5155
23200 68 KL=NCNT(J,L)
23300 IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
23400 PM=KL+1
23500 PAR=PM+V(KL)-1
23600 KL=PAR+1
23700 IF(V(KL).EQ.10000.)DUR(J)=BT
23800 C 'END' OR 'FINE' IN 'LIT' LIST.
23900 IF(V(KL).EQ.999.)KL=IJ+2
24000 NCNT(J,L)=KL
24100 GO TO 5155
24200 C ******* JAN 20 *************
24300 1155 IF(PAR.EQ.10000.)GO TO 5174
24400 C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
24500 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
24600 C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
24700 5155 P(L)=PAR
24800 21551 PL(L)=PM
24900 IF(ISUB)GO TO 601
25000 IF(L.EQ.2)GO TO 4203
25100 21552 IF(IDF.GE.0)GO TO 2155
25200 DF=PAR
25300 C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
25400 IDF=0
25500 2155 CONTINUE
25600
25700 9203 IF(KB.EQ.0)GO TO 1170
25800 NL=KB
25900 DO 2203 K=1,KB
26000 X=OTH(NL,1)
26100 IF(X.LT.100000.)GO TO 2203
26200 L=X/100000.
26300 Y=(X-L*100000.)/100.
26400 IX=Y
26500 JC=NL
26600 IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203
26700 2203 NL=NL-1
26800 GO TO 1170
26900 4203 PR=P2
26910 PX2=P2
26920 C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
27000 IF(T5.EQ.0)GO TO 7203
27100 IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
27200 3155 IT3=IT3+3
27300 TBG=TBG+TDUR
27400 TDUR=V(IT3)
27500 IF(BT.GE.TBG+TDUR)GO TO 3155
27600 T1=V(IT3+1)
27700 T2=V(IT3+2)
27800 CALL SQYY(AC,T1,T2,TDUR)
27900 6203 RA=PR
28000 IF(BT.EQ.TBG)XT(J)=T1
28100 K=IT3
28200 RC=0
28300 RD=1
28400 KA=1
28500 RB=0
28600 Z=TDUR+TBG-BT
28700 X=T1
28800 Y=T2
28900 YY=AC
29000 CHN=TBG
29100 ZZ=TDUR
29200 CALL ACCEL
29300 8203 P2=RA*RD
29400 7203 P2=P2*T4
29500 X=P2*TF
29600 C P2 IS KEPT WITHOUT TF*
29700 K=X+.5
29800 IF(X)K=X-.5
29900 72031 ROFF(J)=ROFF(J)+K-X
30000 IF(ABS(ROFF(J)).LT.1.)GO TO 7155
30100 Y=1.
30200 IF(ROFF(J))Y=-1.
30300 K=K-Y
30400 ROFF(J)=ROFF(J)-Y
30500 C ROUND-OFF GAP WILL NOT EXCEED .001
30600 C*********** FEB 17,71
30700 7155 PP2=K/1000.
30800 C AVOIDS ROUND-OFF PROBLEMS
30900 C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
31000 IF(IPT(J,31).EQ.0)GO TO 6155
31100 IF(ICT)GO TO 1170
31200 X=V(IPT(J,31)+2)/2.
31300 Y=RAND(-X,X)
31400 IF(PP2.GE.0)GO TO 615
31500 MK=-1
31600 PP2=-PP2
31700 615 PP2=PP2-RDEV(J)+Y
31800 RDEV(J)=Y
31900 C TOTAL RAND DEV. WON'T EXCEED P31
32000 C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
32100
32200 K=PP2*1000.+.5
32300 C****** CHECK THIS OUT 1/10/72 :::::::
32400 61551 PP2=K/1000.
32500 C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
32600 6155 IF(ICT)GO TO 9203
32700 GO TO 2155
32800 5203 JD=Y*100-IX*100+.5
32900 IF(JD.GT.0)GO TO 3203
33000 M=0
33100 P1(J)=PP1+PP2
33200 GO TO 7021
33300 3203 P(JD)=OTH(JC,2)
33400 X=OTH(JC,3)
33500 IF(X.NE.1.)X=3.
33600 C 'EDITS' PRINT,NUM. OR 5 CHARS.
33700 PL(JD)=X
33800 C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
33900 IF(JD.EQ.2)PP2=P2
34000 C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
34100 1170 IF(MK.OR.PP2)GO TO 2022
34200
34300 ZPAR=PP1
34400 P1(J)=PP1+PP2
34500 C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
34600 LK=INST(J)
34700 2021 IF(PP1.LT.OP1)GO TO 2612
34800 IF(INVIS(J).LT.0)GO TO 2170
34900 C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
35000 IF(INONLY.GT.0)GO TO 1204
35100 C*********** MAY 16,71 ↑↑↑
35200 6021 IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
35300 C******* MAY 25,71
35400 C 'LIT' DATA WILL ALWAYS PRINT.
35500 NPA=NPA-1
35600 IF(NPA.GT.2)GO TO 6021
35700 5021 DO 1304 K=3,NPA
35800 1304 COPY(K)=P(K)
35900 1204 IF(PL4.NE.1.)GO TO 2170
36000 P4=P4*AMPFAC
36100 L=0
36200 INP(J)=P4
36300 DO 1021 K=1,NINS
36400 1021 IF(P1(K).GT.PP1)L=L+INP(K)
36500 IF(L-IAMP-1)GO TO 2170
36600 IAMP=L
36700 AMPTIM=PP1
36800 2170 IF(MX.EQ.3)GO TO 2612
36900 C ********* MAY 17,71
37000 PP1=PP1-OP1
37100 C PUTS SPACES BETWEEN NOTES .GT. .05( APART
37200 IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
37300 IF(INONLY)WRITE(JOUT,902)
37400 A=PP1+.05
37500 5170 ML=10
37600 IF(NPA.LT.10)ML=NPA
37700 MLX=3
37800 NL=2
37900 IF(INVIS(J).EQ.0)GO TO 3170
38000 LK=0
38100 C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
38200 C NEXT CREATES FORMAT DATA IN IFM ARRAY.
38300 31701 KL=3
38400 GO TO 4170
38500 3170 IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
38600 VX(1)=PP1
38700 IF(DF.GT.0)GO TO 6170
38800 VX2=-DF
38900 IF(VX2.GT.PP2)VX2=PP2
39000 C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
39100 GO TO 7170
39200 6170 IF(DF.LT.100)GO TO 8170
39300 C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
39400 VX2=PP2-DF+100.
39500 IF(VX2.LE.0)VX2=PP2/2.
39600 C NO NEG. TIME VALUES ALLOWED.
39700 GO TO 7170
39800 8170 VX2=PP2*DF
39900 7170 IFM3='F9.3,'
40000 IFM4=IFM3
40100 KL=5
40200 IF(NPA.LT.3)GO TO 2121
40300
40400 4170 NL=2
40500 DO 1121 K=MLX,ML
40600 X=P(K)
40700 L=PL(K)
40800 IF(L-2)321,521,621
40900 C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
41000 321 IF(X.GE.0)GO TO 4211
41100 IFM(KL)=IFCOM
41200 NL=NL+1
41300 KL=KL+1
41400 4211 IFM(KL)='F9.3,'
41500 C CREATES 'F9.3'
41600 421 VX(KL-NL)=X
41700 GO TO 1121
41800 521 IFM(KL)=IFM2
41900 C CREATES '1XA5'
42000 LN=X
42100 VX(KL-NL)=SCAL(LN)
42200 GO TO 42
42300 621 IF(L.GT.3)GO TO 721
42400 VX(KL-NL)=X
42500 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42600 42 IFM(KL)=IFM2
42700 GO TO 1121
42800 721 LN=X
42900 IFM(KL)=I1X
43000 NL=NL+1
43100 DO 821 M=1,LN-L+1
43200 KL=KL+1
43300 IOUT(KL-NL)=IV(L-1+M)
43400 821 IFM(KL)=IA1
43500 1121 KL=KL+1
43600
43700 C NO MORE THAN 80 ITEMS IN FORMAT.
43800 2121 IF(KL.LE.80)GO TO 21211
43900 21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
44000 TYPE 21212
44100 21211 DO 921 M=KL+1,80
44200 921 IFM(M)=IBLA
44300 IFM(KL)=')'
44400 L=KL-NL-1
44500 IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
44600 IF(.NOT.MZ)GO TO 30210
44700 IF(ML.GE.NPA)IFM(KL)='$)'
44800 WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
44900 30210 IF(ML.GE.NPA)GO TO 3021
45000 MLX=ML+1
45100 ML=ML+10
45200 IF(ML.GT.NPA)ML=NPA
45300 LK=IBLA
45400 GO TO 31701
45500 3021 IF(MX)WRITE(1,3616)INST(J),ICT
45600 30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
45700 2612 PP1=ZPAR
45800 GO TO 21
45900 8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
46000 3616 FORMAT(';PRINT(P1);< ',A5,I4)
46100 C PRINTS RESTS
46200 2022 PP2=ABS(PP2)
46300 C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
46400 C FOR RESTS IN SEQS. TYPE -DUR.
46500 C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
46600 C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
46700 INP(J)=0
46800 P1(J)=PP1+PP2
46900 C STORES NEXT P1 TIME FOR THIS INST.
47000 IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
47100 X=PP1-OP1
47200 IF(A.GE.X)GO TO 121
47300 WRITE(JOUT,902)
47400 A=X+.05
47500 121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
47600 1 J,INST(J),ICT
47700 21 PR=ABS(PR)
47800 BG(J)=BT+PR
47900 IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
48000 IF(BG(J).LT.DUR(J))GO TO 500
48100 5174 BG(J)=19999.
48200 DO 3174 K=1,NINS
48300 C INSERTS CANT FOLLOW LAST REGULAR NOTE.
48400 C (ADD REST IF INSERT AT END IS NEEDED.)
48500 3174 IF(BG(K).LT.19999.)GO TO 500
48600 GO TO 175
48700 C CHOOSES INST WITH NEXT BEGIN TIME.
48800 500 J=1
48900 BW=BT
49000 NL=NINS+KB
49100 DO 22 K=2,NL
49200 22 IF(BG(J).GT.BG(K))J=K
49300 IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
49400 J=1
49500 DO 5022 K=2,NINS
49600 X=P1(J)
49700 Y=P1(K)+.0001
49800 C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
49900 IF(BG(J).EQ.19999.)X=19999.
50000 IF(BG(K).EQ.19999.)Y=19999.
50100 5022 IF(X.GT.Y)J=K
50200 C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
50300 3022 BT=BG(J)
50400 IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
50500 IF(CNT(J).GT.0)GO TO 1022
50600 IF(CNT(J).EQ.0)P1(J)=0
50700 IF(CNT(J).EQ.-1)CNT(J)=0
50800 C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
50900 1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
51000 T4=T2
51100 T5=0
51200 T6=10000.
51300 GO TO 1108
51400 1175 FORMAT('+',A5,'=',F7.3,2X,$)
51510 1109 FORMAT(' FINISH; < ',A5,'.DAT')
51600 1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
51700 1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
51800 1,F8.3)
51910 175 IF(MZ)WRITE(JOUT,1109),ISLAC
52000 IF(MX.GE.0)GO TO 4175
52110 WRITE(1,1109),ISLAC
52205 END FILE 1
52300 603 FORMAT(' TOTAL DURS: ',$)
52400 CC FOR COLGATE ONLY***4175 CALL ENDSUB
52500 C CLEARS CNTL O --- IF YOU HAVE HIT IT.
52600 4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
52700 WRITE(JOUT,603)
52800 5175 DO 2175 K=1,NINS
52900 X=P1(K)-OP1
53000 IF(MZ)GO TO 6175
53100 TYPE 1175,INST(K),X
53200 GO TO 2175
53300 6175 WRITE(JOUT,1175),INST(K),X
53400 2175 CONTINUE
53510 3175 TYPE 1023,ISLAC
53550 CALL EXIT
53600 END